home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / os2 / adaptor.zip / ADAPT.ZIP / adaptor / examples / databnch / comm.fcm next >
Text File  |  1993-03-23  |  13KB  |  397 lines
  1. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  2. C                                                                    C
  3. C                                                                    C
  4. C      Benchmark Program for data parallel operations                C
  5. C                                                                    C
  6. C      ADAPTOR Version 1.0                                           C
  7. C                                                                    C
  8. C      Author: Dr. Thomas Brandes, GMD, I1.HR                        C
  9. C      Date:   December, 1992                                        C
  10. C                                                                    C
  11. C      measures data parallel operations with communication          C
  12. C                                                                    C
  13. C         - reduction operations                                     C
  14. C         - broadcast operations                                     C
  15. C         - shifting opertions                                       C
  16. C         - irregular communication                                  C
  17. C                                                                    C
  18. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  19.  
  20.       program communication
  21.       integer nproc, size, npts, nops, op
  22.       integer i, j, k, number
  23.       parameter (npts = 11, nops = 5)
  24.       real time (nops, npts), usec, mflops, mops
  25. cmf$  layout time(:serial,:serial)
  26.       write (6,*) 'Input number of processors : '
  27.       read (5,*) nproc
  28.       call overhead (tover)
  29.       write (6,*) '==============================================='
  30.       write (6,*) '|                                             |'
  31.       write (6,*) '| ADAPTOR BENCHMARK PROGRAM by Thomas Brandes |'
  32.       write (6,*) '|                                             |'
  33.       write (6,*) '==============================================='
  34.       write (6,*) ' '
  35.       write (6,*) 'BENCHMARK FOR P = ', nproc
  36.       write (6,*) '==============================='
  37.       write (6,*) ' '
  38. c
  39. c     testing reduction functions
  40. c
  41.       write (6,*) ' '
  42.       write (6,*) 'ADAPTOR:    reduction functions'
  43.       write (6,*) '==============================='
  44.       write (6,*) ' '
  45.       write (6,*) ' r = redop (x(1:size*nproc)) '
  46.       write (6,*) ' '
  47.  
  48.       do op = 1, 2
  49.          size = 1
  50.          do i = 1, npts
  51.             call reduction (op, size, nproc, time(op,i))
  52.             time(op,i) = time(op,i) - tover
  53. c           write (6,*) 'size = ', size, ' time = ', time(op,i)
  54.             size = size * 2
  55.          end do
  56.          if (op .eq. 1) write (6,*) 'r = sum(x)    (1 Flop)'
  57.          if (op .eq. 2) write (6,*) 'r = minval(x) (1 Flop)'
  58.          write (6,*) ' size     usec    MOps (1)   MOps(all)'
  59.          do i = 1, npts
  60.            size = 2**(i-1)
  61.            usec = time(op,i) * 1e6
  62.            mflops = 1e-6*size/time(op,i)
  63.            write (6, '(i6,f10.0,2f9.3)') size, usec, mflops, mflops*nproc
  64.          end do
  65.          write (6,*)
  66.       end do
  67. c
  68. c     testing replicate/broadcast functions
  69. c
  70.       write (6,*) ' '
  71.       write (6,*) 'ADAPTOR:    replicate functions'
  72.       write (6,*) '==============================='
  73.       write (6,*) ' '
  74.       write (6,*) ' x (1:size, 1:nproc) distributed '
  75.       write (6,*) ' '
  76.  
  77.       do op = 1, 4
  78.          size = 1
  79.          do i = 1, npts
  80.             call replicate (op, size, nproc, time(op,i))
  81.             time(op,i) = time(op,i) - tover
  82. c           write (6,*) 'size = ', size, ' time = ', time(op,i)
  83.             size = size * 2
  84.          end do
  85.          if (op .eq. 1) then 
  86.             write (6,*) 'replicate every single elements'
  87.             write (6,*) 'r1 = x(i,j), i=1:size, j=1:nproc'
  88.             number = size * nproc
  89.           else if (op .eq. 2) then
  90.             write (6,*) 'replicate every column (one process sends)'
  91.             write (6,*) 'r2 = x(1:size,j), j=1:nproc'
  92.             number = nproc
  93.           else if (op .eq. 3) then
  94.             write (6,*) 'replicate every row'
  95.             write (6,*) 'r3 = x(i,1:nproc), i=1:size'
  96.             number = size
  97.           else if (op .eq. 4) then
  98.             write (6,*) 'full replicate'
  99.             write (6,*) 'r4 = x(1:size,1:nproc)'
  100.             number = 1
  101.          end if
  102.          write (6,*) ' size     usec    #rep   usec/#rep   kBytes/s '
  103.          do i = 1, npts
  104.            size = 2**(i-1)
  105.            usec = time(op,i) * 1e6
  106.            if (op .eq. 1) number = size * nproc
  107.            if (op .eq. 2) number = nproc
  108.            if (op .eq. 3) number = size
  109.            if (op .eq. 4) number = 1
  110.            mflops = 4 * size * nproc * 1e-3 / time(op,i)
  111.            write (6, '(i6,f10.0,i6,f10.0,f12.2)') size, usec, number, 
  112.      &                                            usec/number, mflops
  113.          end do
  114.          write (6,*)
  115.       end do
  116. c
  117. c     testing circular shift operation
  118. c
  119.       do op = 1, 2
  120.          size = 1
  121.          do i = 1, npts
  122.             call mcshift (op, size, nproc, time(op,i))
  123.             time(op,i) = time(op,i) - tover
  124.             size = size * 2
  125.          end do
  126.          write (6,*) ' '
  127.          if (op .eq. 1) write (6,*)
  128.      $           'ADAPTOR: CSHIFT data parallel operation'
  129.          if (op .eq. 2) write (6,*)
  130.      $           'ADAPTOR: EOSHIFT data parallel operation'
  131.          write (6,*) '======================================='
  132.          write (6,*) ' size     usec      kB/s      kB/s (total)'
  133.          do i = 1, npts
  134.               size = 2**(i-1)
  135.               usec = time(op,i) * 1e6
  136.               mflops = 4 * size * 1e-3 / time(op,i)
  137.               write (6, '(i6,f10.0,2f12.2)') size, usec, 
  138.      &                                       mflops, mflops * nproc
  139.          end do
  140.          write (6,*)
  141.       end do 
  142. c
  143. c     testing irregular communication operation
  144. c
  145.       write (6,*) 'ADAPTOR: irregular communication patterns'
  146.       write (6,*) '========================================='
  147.       write (6,*) ' '
  148.       write (6,*) 'real x(size * nproc), z (size * nproc)'
  149.       write (6,*) 'integer p (size * nproc)'
  150.       do op = 1, 3
  151.          size = 1
  152.          do i = 1, npts
  153.             call mirregular (op, size, nproc, time(op,i))
  154.             time(op,i) = time(op,i) - tover
  155.             size = size * 2
  156.          end do
  157.          write (6,*) ' '
  158.          if (op .eq. 1) write (6,*) 'z = x(p), p = 1:nproc*size'
  159.          if (op .eq. 2) write (6,*) 'z = x(p), p = nproc*size:1:-1'
  160.          if (op .eq. 3) write (6,*) 'z = x(p), p = random'
  161.          write (6,*) ' '
  162.          write (6,*) ' size     usec      kB/s      kB/s (total)'
  163.          do i = 1, npts
  164.               size = 2**(i-1)
  165.               usec = time(op,i) * 1e6
  166.               mflops = 4 * size * 1e-3 / time(op,i)
  167.               write (6, '(i6,f10.0,2f12.2)') size, usec, 
  168.      &                                       mflops, mflops * nproc
  169.          end do
  170.          write (6,*)
  171.       end do 
  172.       write (6,*) 'Benchmark ready'
  173.       end
  174.  
  175. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  176. C                                     C
  177. C     measure reductions              C
  178. C                                     C
  179. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  180.  
  181.       subroutine reduction (op, size, nproc, time)
  182.       integer op, size, nproc
  183.       real time, t0, t1
  184.       real x(size*nproc), result
  185.       integer i, nloop
  186.       x = 3.0
  187.       nloop = 1
  188.  10   if (op .eq. 1) then
  189.         call walltime (t0)
  190.         do i = 1, nloop
  191.            if (i .gt. nloop) call dummy1 (x, x, x)
  192.            result = sum (x)
  193.         end do
  194.         call walltime (t1)
  195.         check = result
  196.        else if (op .eq. 2) then
  197.         call walltime (t0)
  198.         do i = 1, nloop
  199.            if (i .gt. nloop) call dummy1 (x, x, x)
  200.            result = minval (x)
  201.         end do
  202.         call walltime (t1)
  203.         check = result
  204.        else
  205.         write (6,*) 'operation error in intrinsics'
  206.       end if
  207.       time = t1 - t0
  208.       call nloopupdate (time, nloop)
  209.       if (nloop .gt. 0) goto 10
  210. c     write (6,*) 'Reduction = ', op, ' Check = ', check
  211.       end
  212.  
  213. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  214. C                                     C
  215. C     measure replications            C
  216. C                                     C
  217. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  218.  
  219.       subroutine replicate (op, size, nproc, time)
  220.       integer op, size, nproc
  221.       real time, t0, t1
  222.       real x(size,nproc), result2 (size), result3 (nproc)
  223.       real result1, result4 (size,nproc)
  224. cmf$  layout result2 (:serial), result3 (:serial), result4(:serial)
  225.       integer i, j, k, nloop
  226.       x = 3.0
  227.       nloop = 1
  228.  10   if (op .eq. 1) then
  229.         call walltime (t0)
  230.         do i = 1, nloop
  231.            if (i .gt. nloop) call dummy2 (x)
  232.            do k = 1, size
  233.              do j = 1, nproc
  234.                result1 = x(k,j)
  235.              end do
  236.            end do
  237.         end do
  238.         call walltime (t1)
  239.         check = result1
  240.        else if (op .eq. 2) then
  241.         call walltime (t0)
  242.         do i = 1, nloop
  243.            if (i .gt. nloop) call dummy2 (x)
  244.            do j = 1, nproc
  245.              result2 (1:size) = x(1:size,j)
  246.            end do
  247.         end do
  248.         call walltime (t1)
  249.         check = result2 (1)
  250.        else if (op .eq. 3) then
  251.         call walltime (t0)
  252.         do i = 1, nloop
  253.            if (i .gt. nloop) call dummy2 (x)
  254.            do j = 1, size
  255.              result3 (1:nproc) = x(j,1:nproc)
  256.            end do
  257.         end do
  258.         call walltime (t1)
  259.         check = result3 (1)
  260.        else if (op .eq. 4) then
  261.         call walltime (t0)
  262.         do i = 1, nloop
  263.            if (i .gt. nloop) call dummy2 (x)
  264.            result4  = x
  265.         end do
  266.         call walltime (t1)
  267.         check = result4 (1,1)
  268.        else
  269.         write (6,*) 'operation error in replicate'
  270.       end if
  271.       time = t1 - t0
  272.       call nloopupdate (time, nloop)
  273.       if (nloop .gt. 0) goto 10
  274. c     write (6,*) 'Replicate = ', op, ' Check = ', check
  275.       end
  276.  
  277. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  278. C                                     C
  279. C     measure circular shifts         C
  280. C                                     C
  281. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  282.  
  283.       subroutine mcshift (op, size, nproc, time)
  284.       integer op, size, nproc
  285.       real time, t0, t1
  286.       real x(size,nproc)
  287.       integer i, nloop
  288.       forall (j=1:nproc,i=1:size) x(i,j) = float(i) / (2 * float(j) + 1)
  289.       nloop = 1
  290.  10   if (op .eq. 1) then
  291.          call walltime (t0)
  292.          do i = 1, nloop
  293.             if (i .gt. nloop) call dummy2 (x)
  294.             x = cshift (x, 2, 1)
  295.          end do
  296.          call walltime (t1)
  297.        else if (op .eq. 2) then
  298.          call walltime (t0)
  299.          do i = 1, nloop
  300.             if (i .gt. nloop) call dummy2 (x)
  301.             x(1:size,1:nproc-1) = x(1:size,2:nproc)
  302.             x(1:size,nproc) = 0.0
  303.          end do
  304.          call walltime (t1)
  305.        else
  306.          write (6,*) 'operation error in mcshift'
  307.       end if
  308.       time = t1 - t0
  309.       call nloopupdate (time, nloop)
  310.       if (nloop .gt. 0) goto 10
  311.       end
  312.  
  313. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  314. C                                     C
  315. C     measure irregular communicats   C
  316. C                                     C
  317. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  318.  
  319.       subroutine mirregular (op, size, nproc, time)
  320.       integer op, size, nproc
  321.       real time, t0, t1
  322.       real x(size*nproc), z(size*nproc)
  323.       integer p(size*nproc)
  324.       integer i, nloop
  325.       x = 1.5
  326.       if (op .eq. 1) then
  327.         forall (i=1:size*nproc) p(i) = i
  328.       else if (op .eq. 2) then
  329.         forall (i=1:size*nproc) p(i) = size*nproc+1-i
  330.       else if (op .eq. 3) then
  331.         call cmf_random (p,size*nproc)
  332.         p = p + 1
  333.       else 
  334.         write (6,*) 'operation error in mirregular'
  335.       end if
  336.       nloop = 1
  337.  10   call walltime (t0)
  338.       do i = 1, nloop
  339.          if (i .gt. nloop) call dummy1 (x,z,z)
  340.          z = x(p)
  341.       end do
  342.       call walltime (t1)
  343.       time = t1 - t0
  344.       call nloopupdate (time, nloop)
  345.       if (nloop .gt. 0) goto 10
  346.       end
  347.  
  348. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  349. C                                     C
  350. C     loop handling                   C
  351. C                                     C
  352. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  353.  
  354.       subroutine nloopupdate (time, n)
  355.       real time, runtime
  356.       parameter (runtime = 1.0)
  357.       integer n
  358.       if (time .lt. 0.1) then 
  359.          n = n * 10
  360.        else if (time .lt. (runtime / 2.0)) then
  361.          n = n * (runtime / time)
  362.         else
  363.          time = time / n
  364.          n = 0
  365.        end if 
  366.       end
  367.  
  368. c     the next subroutine measures the loop overhead
  369.  
  370.       subroutine overhead (tover)
  371.       real tover, t0, t1, x
  372.       integer nloop
  373.       nloop = 100000
  374.       call walltime (t0)
  375.       do i = 1, nloop
  376.         if (i .gt. nloop) call dummy (x)
  377.       end do
  378.       call walltime (t1)
  379.       tover = (t1 - t0) / nloop
  380.       write (6,*) 'Loop overhead ', tover, ' sec'
  381.       end 
  382.  
  383.       subroutine dummy (x)
  384.       real x
  385.       print *, 'error'
  386.       end
  387.  
  388.       subroutine dummy1 (x, y, z)
  389.       real x(10), y(10), z(10)
  390.       print *, 'error'
  391.       end
  392.  
  393.       subroutine dummy2 (x)
  394.       real x(10,10)
  395.       print *, 'error'
  396.       end
  397.